home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Aminet 15
/
Aminet 15 - Nov 1996.iso
/
Aminet
/
comm
/
cnet
/
cnet_who.lha
/
Who
/
Normal
< prev
next >
Wrap
Text File
|
1996-08-26
|
5KB
|
60 lines
/**************************************************************************\
$VER: CNet Normal WHO, v2.64 (26-Aug-96) by Dotoran!
\**************************************************************************/
options results;signal on SYNTAX;signal on ERROR;signal on IOERR
tr=transmit;se=sendstring;gu=getuser;gs=getscratch;mg=maygetchar;gu 1311992;dp=result
a='rexxsupport.library';if ~show('l',a) then if ~addlib(a,0,-30) then exit;call SETGU
changewhere 'Normal WHO';low=0;gu guHP;high=result;gu 23;myport=result;gu 55;help=result
gu 2107337;idle=result;gu 1100661;conf=BitTST(d2c(result,4),7);call CONFIG;gu 1302307;arg=upper(result)
if arg=''|arg='C' then args=low'-'high;if arg>''&arg~='?'&left(arg,1)~='C' then call ARGS
tot=high;call PARSER(args,0,high);helpT='n1cfNormal Whoc6, vcb2c6.cb64 c6by cdDotorann2'
helpT=helpT'c7Formatce: caWH c7[c6portce# c6pce#cb-c6pce# c6pce#cb,c6pce# cb-c6pce# c6pce#cb-c7]'
if totpit=0 then arg='?';if arg='?' then do;tr helpT;exit;end;if left(arg,1)='C'&conf=1 then do
se 'n1c3Loading z4c7NORMALz0 c3who config...';tr '#0'dp'Config}';exit;end
v1=1;v2=1;v4=0;v5=0;v6=0;loS=0;hiS=0;v7=0;v10=0;if v7=1 then tr 'f1'
if getclip('IdleWhoB0')='' then sendstring '#0'dp'Loader}'
tr "n1z6c4Portz0 z6c4User Handle z0 z6c4Logon z0 z6c4Spdz0 z6c4From z0 z6c4Where z0";call MGC
tr "cc==== ==================== ====== === ======================== ================="
do ii=1 to totpit;i=subword(it.0,ii,1);if index(' 'it.0' ',i)=0 then iterate ii
if v6=1&ii=loS+1 then do;ii=hiS-1;iterate ii;end;port=i;st=' ';gu 1101630+i;a=d2c(result);call MGC
mu=BitTST(a,1);if mu=1 then st='m';hi=BitTST(a,0);if hi=1&myport~=i then st='h'
getportid i;id=result;getwhere i;where=left(result,17);gu pd+(i*4);zy=c2d(import(offset(null(),result+30),2))
call MINUTES(zy);iT=zz;if where='(offline)' then iterate ii;if id=-1&(idle=1|v4=1 )then iterate ii
off=1630+myport;gu pd+(i*4);hidden=result+off;hide=BitTST(import(offset(null(),hidden),1),0)
muff=BitTST(import(offset(null(),hidden),1),1);gu 1200032;a=result
if hide=1&conf~=1 then do;a=a+random(fakeL,fakeH,time('s'))*10;id=-1;call MINUTES(a);iT=zz;end
call MGC;if hide=1&conf~=1&v5=1 then iterate ii
if id>-1 then do;loadscratch id;savescratch (-id);gs 1101333;con=BittST(d2c(result,4),7)
if con=1&myport~=i then st='+';if muff=1&con=0&st~='h' then st='M'
if hide=1&con=0 then st='H';if v1=1&zy>5 then where='c9Idle ce'iT
gs 1;handle=result;gs 1201214;cps=result%10;gs 4;city=result;gs 56;country=result
gs 57;logon=right(result,6);gs 38;who=result;call MGC;end
else do;handle=l903;where=l107;cps=0;city='';country='';logon=''
who='';time=0;if v1=1&where=l107 then where='c9Idle cb'iT
a='';if v2=1 then a=getclip('IdleWhoB'i);if a='' then a=getclip('IdleWhoBD');call MGC;end
if id>-1|a='' then do;se 'cf'right(port,2)' cb'st' ce'handle'.26}cd'right(logon,6)
tr ' cb'right(cps,3)' c6'left(city,21)left(country,3)' c9'where;call MGC;end
if id=-1&a~='' then do;tr 'cf'right(port,2)' cb'st' 'a'.62}c9'where;call MGC;end
if who~='' then tr copies(' ',37)'@8ca'who;call MGC
end ii;tr 'cc===============================================================================';if help=3 then exit
if help=2 then do;se ' cbm cf= cbMuffledcf, cbh cf= cbHiddencf, '
tr 'cb+ cf= cbConference Control';exit;end;a=" cbm cc= cdYou're Muffling this Port. "
if conf=1 then a=a"cbM cc= caThey're trying to Muffle You.";tr a;a=" cbh cc= cayou're Hiding from this Port. "
if conf=1 then a=a"cbH cc= cdThey're trying to Hide from You.";tr a;tr " cb+ cc= c9user has Conference Control.";exit
MGC:;mg;if result='NOCHAR' then return;else do;tr l1066;exit;end
ARGS:;gu 1202244;total=result-1;args='';do i=0 to total+1;gu 1302307+(i*61);args=args||result' ';end i;return
PARSER:;arg rng,min,max;it.='';c=0;it=translate(rng,' ','.,');do a=1 to words(it);c=c+1;it.c=word(it,a)
if index(it.c,'-')>0 then do;parse var it.c x'-'y;if y='' then y=max;if x='' then x=min;if x>y then do;d=x;x=y;y=d;end
if x<min|y>max|~datatype(x,'W')|~datatype(y,'W') then do;c=c-1;iterate;end;do b=x to y;it.c=b;c=c+1;end;c=c-1;end
else if it.c<min|it.c>max|~datatype(it.c,'W') then do;c=c-1;iterate;end;end;totpit=c;do i=1 to c;it.0=it.0||it.i' ';end;return
MINUTES:;arg m;t=right(m,1);m=m%10;dys=m%1440;hrs=(m-(dys*1440))%60;mins=m-((dys*1440)+(hrs*60));d='cb'dys'ced';zz='cb'hrs'ceh cb'mins'cem cb't*6'ces';if v10=1 then zz=d||zz;return
CONFIG:;call open(f1,dp'config.data','r');a=readln(f1);call close(f1);parse var a l107''l903''l1066''fakeL''fakeH''junk;return
SETGU:;bbsidentify bbs;v=(left(word(result,5),4)>"4.13")+1;guHP=word("2225094 2227656",v);pd=word("2424286 2426848",v);return
SYNTAX:;ERROR:;IOERR:;e1=' Error: 'rc' ('errortext(rc)')';e2=' Line: 'left(sigl,4)'File:';gu 1311992;a=result
gu 1311960;b=result;c='"'a||b'"';e2=e2' 'c;tr e1;tr e2;logentry e1;logentry e2;e=sourceline(sigl)
do while e~='';e3='Source: 'left(e,37);tr e3;logentry e3;e=substr(e,38);end;bufferflush;exit
/**************************************************************************\
\****************************************** Frontiers BBS (716)/823-9892 **/